home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / D-G / FORTRAN Goodies / SetVol.txt < prev    next >
Encoding:
Text File  |  1992-01-31  |  1.4 KB  |  50 lines  |  [TEXT/MPS ]
  1. C    SetVolume.f is an example of how to use SetVolume
  2. C    and other Language System functions to manipulate
  3. C    which folder datafiles are written to. 
  4.  
  5. C    Example provided for owners of Language Systems FORTRAN
  6. C    © 1992 Language Systems Corp.
  7.  
  8.     program SetVolume
  9.     integer*4    VolumeRef(2),OldRef
  10. c
  11.     write(*,*) '  F_SetVolume() Demo'
  12.     write(*,*)
  13.     
  14. c remember the current directory
  15.     OldRef = JVRefnum(int4(-1))
  16.     
  17. c choose a file somewhere, record its directory
  18.     call alertBox('Please choose an existing file.')
  19.     open(10,file=*,status='old',err=900)
  20.     VolumeRef(1) = JVRefnum(int4(10))
  21.     
  22. c choose a destination, record its directory
  23.     call alertBox('Now specify the location of a new file.')
  24.     open(20,file=*'File to be created:',status='new',err=900)
  25.     VolumeRef(2) = JVRefnum(int4(20))
  26. c
  27. c Now we have reference numbers for all 3 directories
  28. c
  29. c Set the directory to the folder where unit 10 lives
  30. c  and create a new file there.
  31.     call F_SetVolume(VolumeRef(1))
  32.     open(15,file='new1',status='new')
  33.     write(15,*) 'hello'
  34. c
  35. c Set the directory to the folder where unit 20 lives
  36. c  and create a new file there.
  37.     call F_SetVolume(VolumeRef(2))
  38.     open(25,file='new2',status='new')
  39.     write(25,*) 'hello'
  40. c
  41. c Set the directory back to the folder where this program lives
  42. c  and create a new file there.
  43.     call F_SetVolume(OldRef)
  44.     open(35,file='new3',status='new')
  45.     write(35,*) 'hello'
  46.     
  47.     ! FORTRAN will close all files    
  48. 900    continue
  49.     end
  50.